/* GUI CONVERTED from rsrp11.p (converter v1.75) Sat Aug 12 23:15:50 2000 */
/* rsrp11.p - Supplier Shipping Scheduled to Planning Schedule Compare Rpt  */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                      */
/* All rights reserved worldwide.  This is an unpublished work.             */
/*V8:ConvertMode=Report                                                     */
/*                                                                          */
/* REVISION: 9.0    CREATED: 09/22/98           BY: *K1QZ* Pat McCormick    */
/* REVISION: 9.0    CREATED: 01/21/99           BY: *M068* Steve Nugent     */
/* REVISION: 9.0   MODIFIED: 03/13/99           BY: *M0BD* Alfred Tan       */
/* REVISION: 9.1 LAST MODIFIED: 03/24/00        BY: *N08T* Annasaheb Rahane */
/* REVISION: 9.1 LAST MODIFIED: 08/12/00        BY: *N0KP* myb              */


/* -----  W A R N I N G  -----  W A R N I N G  -----  W A R N I N G  -----  */
/*                                                                          */
/*         THIS PROGRAM IS A BOLT-ON TO STANDARD PRODUCT MFG/PRO.           */
/* ANY CHANGES TO THIS PROGRAM MUST BE PLACED ON A SEPARATE ECO THAN        */
/* STANDARD PRODUCT CHANGES.  FAILURE TO DO THIS CAUSES THE BOLT-ON CODE TO */
/* BE COMBINED WITH STANDARD PRODUCT AND RESULTS IN PATCH DELIVERY FAILURES.*/
/*                                                                          */
/* -----  W A R N I N G  -----  W A R N I N G  -----  W A R N I N G  -----  */

         /*DISPLAY TITLE */

/*GUI preprocessor directive settings */
&SCOPED-DEFINE PP_GUI_CONVERT_MODE REPORT

         {mfdtitle.i "b+ "}

/*M068*/ /* CHANGED SPELLING OF "Id" FOR rsrp11_p_3 and rsrp11_p_4 to "ID" */

/* **************** Begin Translatable Strings Definitions **************** */

         &SCOPED-DEFINE rsrp11_p_1 "Variance % "
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_2 "ABC Class"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_3 "Plan Release ID"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_4 "Ship Release ID"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_5 "Plan Discrete Qty"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_6 "Ship Discrete Qty"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_7 "Plan Cum Qty"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_8 "Ship Cum Qty"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_9 "Qty Diff"
         /* Max Len: Comment */
         &SCOPED-DEFINE rsrp11_p_10 "Cum Qty Diff"
         /* Max Len: Comment */

/* ***************** End Translatable Strings Definitions ******************* */

         define buffer ship_mstr       for sch_mstr.
         define buffer ship_det        for schd_det.

/*                                   Variables                                */

         define variable wk_plan_date  like schd_date no-undo.
         define variable wk_plan_rlid  like sch_rlse_id no-undo.
         define variable wk_ship_rlid  like sch_rlse_id no-undo.
         define variable var_astric    as character format "x" no-undo.
         define variable diff_qty      like ld_qty_oh label
                                                     {&rsrp11_p_9} no-undo.
         define variable cum_diff_qty  like ld_qty_oh label
                                                     {&rsrp11_p_10} no-undo.
         define variable po_from       like po_nbr no-undo.
         define variable po_to         like po_nbr no-undo.
         define variable var_variance  as  decimal
            format "99" label {&rsrp11_p_1} no-undo.
         define variable var_percent_qty  as  decimal
            format "ZZZ99" label {&rsrp11_p_1} no-undo.
         define variable var_percent_cum  as  decimal
            format "ZZZ99" label {&rsrp11_p_1} no-undo.
         define variable wk_percent_qty as decimal format "999.99" no-undo.
         define variable wk_percent_cum as decimal format "999.99" no-undo.
         define variable wk_variance   as decimal format ".99" no-undo.
         define variable var_abc_class as  character
            format "x" label {&rsrp11_p_2} no-undo.
         define variable wk_del_flag   like mfc_logical no-undo.
         define variable wk_delta      like schd_discr_qty no-undo.
         define variable wk_upper_lmt  like schd_discr_qty no-undo.
         define variable wk_lower_lmt  like schd_discr_qty no-undo.
         define variable part_from     like pod_part no-undo.
         define variable part_to       like pod_part no-undo.
         define variable supplier_from like po_vend no-undo.
         define variable supplier_to   like po_vend no-undo.
         define variable plan_schd_discr_qty
                                       like schd_discr_qty no-undo.
         define variable ship_schd_discr_qty
                                       like schd_discr_qty no-undo.

/*                             Temp Tables                                    */

         define temp-table ship_schd_day no-undo
                field ssd_nbr       like po_nbr
                field ssd_line      like schd_line
                field ssd_date      like schd_date
                field ssd_part      like pod_part
                field ssd_plan_rlid like schd_rlse_id label {&rsrp11_p_3}
                field ssd_ship_rlid like schd_rlse_id label {&rsrp11_p_4}
                field ssd_plan_flag as logical
                field ssd_ship_flag as logical
                field ssd_plan_qty  like schd_discr_qty label {&rsrp11_p_5}
                field ssd_ship_qty  like schd_discr_qty label {&rsrp11_p_6}
                field ssd_plan_cum  like schd_cum_qty label {&rsrp11_p_7}
                field ssd_ship_cum  like schd_cum_qty label {&rsrp11_p_8}
                field ssd_fc_qual   like schd_fc_qual
                field ssd_interval  like schd_interval
                field ssd_cum_qty   like schd_cum_qty
                field ssd_pct_qty   as decimal
                                    format "ZZZ99"
                                    label {&rsrp11_p_1}
                field ssd_pct_cum   as decimal
                                    format "ZZZ99"
                                    label {&rsrp11_p_1}
                index ssd_index1    is unique primary
                                    ssd_nbr
                                    ssd_line
                                    ssd_date.

        
/*GUI preprocessor Frame A define */
&SCOPED-DEFINE PP_FRAME_NAME A

FORM /*GUI*/ 
           
 RECT-FRAME       AT ROW 1 COLUMN 1.25
 RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL VIEW-AS TEXT SIZE-PIXELS 1 BY 1
 SKIP(.1)  /*GUI*/
po_from              colon 20
           po_to                colon 50 label {t001.i}
           part_from            colon 20
           part_to              colon 50 label {t001.i}
           supplier_from        colon 20
           supplier_to          colon 50 label {t001.i}
           skip (1)
           var_variance         colon 20
           var_abc_class        colon 20
        with frame a side-labels width 80 attr-space NO-BOX THREE-D /*GUI*/.

 DEFINE VARIABLE F-a-title AS CHARACTER INITIAL "".
 RECT-FRAME-LABEL:SCREEN-VALUE in frame a = F-a-title.
 RECT-FRAME-LABEL:HIDDEN in frame a = yes.
 RECT-FRAME:HEIGHT-PIXELS in frame a =
  FRAME a:HEIGHT-PIXELS - RECT-FRAME:Y in frame a - 2.
 RECT-FRAME:WIDTH-CHARS IN FRAME a = FRAME a:WIDTH-CHARS - .5.  /*GUI*/

/*GUI preprocessor Frame A undefine */
&UNDEFINE PP_FRAME_NAME



        /* SET EXTERNAL LABELS */
        setFrameLabels(frame a:handle).

         {wbrp01.i}
         repeat:
            display var_variance with frame a.
            if po_to   = hi_char then po_to = "".
            if part_to = hi_char then part_to = "".
            if supplier_to = hi_char then supplier_to = "".
            if c-application-mode <> 'WEB' then do:
               update
                  po_from
                  po_to
                  part_from
                  part_to
                  supplier_from
                  supplier_to
                  var_variance
                  var_abc_class
               with frame a.
            end. /* do */
            {wbrp06.i &command = update &fields = "  po_from po_to part_from
            part_to supplier_from supplier_to var_variance
            var_abc_class " &frm = "a"}

             if (c-application-mode <> 'WEB')  or
             (c-application-mode = 'WEB' and
             (c-web-request begins 'DATA'))
             then do:
                   bcdparm = "".
                   {mfquoter.i po_from     }
                   {mfquoter.i po_to       }
                   {mfquoter.i part_from   }
                   {mfquoter.i part_to     }
                   {mfquoter.i supplier_from}
                   {mfquoter.i supplier_to }
                   {mfquoter.i var_variance }
                   {mfquoter.i var_abc_class }
                   if po_to = "" then po_to = hi_char.
                   if part_to = "" then part_to = hi_char.
                   if supplier_to = "" then supplier_to = hi_char.
             end.  /* do */
           /* SELECT PRINTER */
           {mfselbpr.i "printer" 132}
/*GUI*/ RECT-FRAME:HEIGHT-PIXELS in frame a = FRAME a:HEIGHT-PIXELS - RECT-FRAME:Y in frame a - 2.

           {mfphead2.i}
             /* Main Loop */
             assign wk_variance = var_variance / 100.
             for each  po_mstr use-index po_vend
                       where po_nbr >= po_from
                       and po_nbr <= po_to
                       and po_vend >= supplier_from
                       and po_vend <= supplier_to no-lock,
                       each pod_det
                       where po_nbr = pod_nbr
                       and pod_curr_rlse_id[2] <> ''
                       and pod_curr_rlse_id[3] <> ''
                       and pod_part >= part_from
                       and pod_part <= part_to no-lock,
                       each pt_mstr
                       where pt_part = pod_part no-lock.
                 if var_abc_class <> "" then
                    if pt_abc <> var_abc_class then
                    next.
                 find last sch_mstr where sch_rlse_id = pod_curr_rlse_id[2]
                         and sch_type = 5
                         and sch_nbr = po_nbr
                         and sch_line = pod_line
                         use-index sch_cr_date
                         no-lock no-error.
                 if not available sch_mstr then
                 next.
                 else
                 wk_plan_rlid = sch_rlse_id.
                 find last sch_mstr where sch_rlse_id = pod_curr_rlse_id[3]
                                    and   sch_type = 6
                                    and   sch_nbr = po_nbr
                                    and   sch_line = pod_line
                                    use-index sch_cr_date
                                    no-lock no-error.
                 if not available sch_mstr then
                 next.
                 else
                 wk_ship_rlid = sch_rlse_id.
                 find last sch_mstr where sch_rlse_id = pod_curr_rlse_id[2]
                                    and sch_type = 5
                                    and sch_nbr = po_nbr
                                    and sch_line = pod_line
                                    use-index sch_cr_date
                                    no-lock no-error.
                 assign plan_schd_discr_qty = 0.
                 for each schd_det
                         where sch_type = schd_type
                         and schd_nbr = sch_nbr
                         and schd_line = sch_line
                         and schd_rlse_id = sch_rlse_id
                         and schd_interval = "W"
                         no-lock
                         break
                         by schd_type
                         by schd_nbr
                         by schd_line
                         by schd_rlse_id
                         by schd_date:

                         assign plan_schd_discr_qty =
                              plan_schd_discr_qty + schd_discr_qty.
                         if last-of (schd_date)
                         then do:
                             create ship_schd_day.
                             assign
                             ssd_nbr       = schd_nbr
                             ssd_line      = schd_line
                             ssd_date      = schd_date
                             ssd_part      = pod_part
                             ssd_plan_rlid = wk_plan_rlid
                             ssd_ship_rlid = wk_ship_rlid
                             ssd_plan_flag = yes
                             ssd_ship_flag = no
                             ssd_plan_qty  = plan_schd_discr_qty
                             ssd_ship_qty  = 0
                             ssd_plan_cum   = schd_cum_qty
                             ssd_fc_qual   = schd_fc_qual
                             ssd_interval  = schd_interval
                             ssd_cum_qty   = schd_cum_qty.
                             assign plan_schd_discr_qty = 0.
                             assign wk_plan_date = schd_date.
                         end. /* do */
                         find last ship_mstr
                                   where ship_mstr.sch_rlse_id =
                                      pod_curr_rlse_id[3]
                                   and   ship_mstr.sch_type = 6
                                   and   ship_mstr.sch_nbr = po_nbr
                                   and   ship_mstr.sch_line = pod_line
                                   use-index sch_cr_date
                                   no-lock no-error.
                         if available sch_mstr
                         then do:
                            assign ship_schd_discr_qty = 0.
                            for each ship_det
                                 where ship_mstr.sch_type = ship_det.schd_type
                                 and ship_det.schd_nbr = ship_mstr.sch_nbr
                                 and ship_det.schd_line = ship_mstr.sch_line
                                 and ship_det.schd_rlse_id =
                                       ship_mstr.sch_rlse_id
                                 and (ship_det.schd_date >= wk_plan_date
                                      and ship_det.schd_date < wk_plan_date + 7)
                                 no-lock
                                 break
                                 by ship_det.schd_type
                                 by ship_det.schd_nbr
                                 by ship_det.schd_line
                                 by ship_det.schd_rlse_id
                                 by ship_det.schd_date:
                                 assign ship_schd_discr_qty
                                     = ship_schd_discr_qty +
                                       ship_det.schd_discr.
                                 if last-of (ship_det.schd_date)
                                 then do:
                                     for first ship_schd_day
                                        where ssd_nbr       = ship_det.schd_nbr
                                        and   ssd_line      = ship_det.schd_line
                                        and   ssd_date      = wk_plan_date
                                        exclusive-lock:
                                     end. /* for first */
                                     if available ship_schd_day
                                     then do:
                                        ssd_ship_flag  = yes.
                                        ssd_ship_qty   = ssd_ship_qty +
                                           ship_schd_discr_qty.
                                        ssd_ship_cum   = ship_det.schd_cum_qty.
                                     end. /* do */
                                     else do:
                                       if ship_schd_discr_qty <> 0
                                       then do:
                                         create ship_schd_day.
                                         assign
                                         ssd_nbr       = ship_det.schd_nbr
                                         ssd_line      = ship_det.schd_line
                                         ssd_date      = ship_det.schd_date
                                         ssd_part      = pod_part
                                         ssd_plan_rlid = wk_plan_rlid
                                         ssd_plan_qty  = 0
                                         ssd_ship_rlid = wk_ship_rlid
                                         ssd_plan_cum  = 0
                                         ssd_plan_flag = no
                                         ssd_ship_flag = yes
                                         ssd_ship_cum  = ship_det.schd_cum_qty
                                         ssd_ship_qty  = ship_schd_discr_qty
                                         ssd_fc_qual   = ship_det.schd_fc_qual
                                         ssd_interval  = ship_det.schd_interval
                                         ssd_cum_qty   = ship_det.schd_cum_qty.
                                       end. /* do */
                                     end. /* else do */
                                  assign ship_schd_discr_qty = 0.
                                 end. /* do if last of */
                            end. /* for each schd_det */
                        end. /* if avaialble */

                 end. /* for each schd_det */
                for each ship_schd_day
                exclusive-lock:
                    wk_del_flag = no.
                    if ssd_plan_qty = ssd_ship_qty then
                        wk_del_flag = yes.
                    if not ssd_plan_flag
                    or not ssd_ship_flag then
                        wk_del_flag = yes.
                    if wk_del_flag = no
                    then do:
                        wk_delta = ssd_plan_qty * wk_variance.
                        wk_upper_lmt = ssd_plan_qty + wk_delta.
                        wk_lower_lmt = ssd_plan_qty - wk_delta.
                        if  ssd_ship_qty < wk_upper_lmt
                        and ssd_ship_qty > wk_lower_lmt
                            then wk_del_flag = yes.
                    end. /* do */
                    if wk_del_flag then
                        delete ship_schd_day.
                    else do:
                        diff_qty = ssd_plan_qty - ssd_ship_qty.
                        cum_diff_qty = ssd_plan_cum - ssd_ship_cum.
                        if diff_qty > 0 then
                            wk_percent_qty = diff_qty / ssd_plan_qty.
                        else do:
                            diff_qty = diff_qty * -1.
                            wk_percent_qty = diff_qty / ssd_plan_qty.
                        end. /* else do */
                        if ssd_plan_qty = 0 then
                            wk_percent_qty = 1.
                        if cum_diff_qty > 0 then
                            wk_percent_cum = cum_diff_qty / ssd_plan_cum.
                        else do:
                            cum_diff_qty = cum_diff_qty * -1.
                            wk_percent_cum = cum_diff_qty / ssd_plan_cum.
                       end. /* else do */
                        if ssd_plan_cum = 0 then
                           wk_percent_cum = 1.
                        ssd_pct_qty = wk_percent_qty * 100.
                        ssd_pct_cum = wk_percent_cum * 100.
                    end. /* else do */
                end. /* for each */
                for each ship_schd_day
                exclusive-lock
                break
                by ssd_nbr
                by ssd_line
                by ssd_date with frame ssddet:
                    /* SET EXTERNAL LABELS */
                    setFrameLabels(frame ssddet:handle).
                    if first-of (ssd_line) then do with frame ssdhead:
                        /* SET EXTERNAL LABELS */
                        setFrameLabels(frame ssdhead:handle).
                        display ssd_nbr
                                ssd_line
                                ssd_part
                                ssd_ship_rlid
                                ssd_plan_rlid
                                with width 132
                                frame ssdhead STREAM-IO /*GUI*/ .
                    end. /* if first-of (ssd_line) then */
                    diff_qty = ssd_plan_qty - ssd_ship_qty.
                    cum_diff_qty = ssd_plan_cum - ssd_ship_cum.
                    display
                            ssd_date
                            ssd_ship_qty
                            ssd_plan_qty
                            diff_qty when (diff_qty <> 0)
                            ssd_pct_qty when (ssd_pct_qty <> 0)
                            ssd_ship_cum
                            ssd_plan_cum
                            cum_diff_qty when (cum_diff_qty <>0)
                            ssd_pct_cum when (ssd_pct_cum <> 0)
                            with width 132
                            frame ssddet
                            down STREAM-IO /*GUI*/ .
                    delete ship_schd_day.
                end. /* for each */
             end. /* for each pod-det */

       /* REPORT TRAILER */
       {mfrtrail.i}
    end.

             {wbrp04.i &frame-spec = a}
